home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok89 / gtb-oberon / demo / fontadapt.mod < prev    next >
Text File  |  1993-11-04  |  11KB  |  323 lines
  1. MODULE FontAdapt;
  2.  
  3. (*
  4.  *  Source generated with OG 37.11 (3.6.93) by Thomas Igracki
  5.  *  OG is based on GenOberon V1.0 by Kai Bolay & Jan van den Baard
  6.  *  GenOberon is based on internal GenOberon by Kai Bolay
  7.  *  internal GenOberon is based on GenC by Jan van den Baard
  8.  *
  9.  *  GUI Designed by : Kai Bolay
  10.  *)
  11.  
  12. IMPORT
  13.   e: Exec, I: Intuition, gt: GadTools, g: Graphics, u: Utility, y: SYSTEM;
  14.  
  15. CONST
  16.   MainHotKeys * = "";
  17.   GDGadget00                        * = 0;
  18.   GDGadget10                        * = 1;
  19.   GDGadget20                        * = 2;
  20.   GDGadget30                        * = 3;
  21.   GDGadget40                        * = 4;
  22.   GDGadget50                        * = 5;
  23.   GDGadget60                        * = 6;
  24.   GDGadget70                        * = 7;
  25.   GDGadget80                        * = 8;
  26.   GDGadget90                        * = 9;
  27.   GDGadget100                       * = 10;
  28.   GDGadget110                       * = 11;
  29.  
  30. CONST
  31.   MainCNT = 12;
  32.   MainLeft = 64;
  33.   MainTop = 45;
  34.   MainWidth = 462;
  35.   MainHeight = 102;
  36. VAR
  37.   Scr-: I.ScreenPtr;
  38.   VisualInfo-: e.APTR;
  39.   MainWnd-: I.WindowPtr;
  40.   MainGList-: I.GadgetPtr;
  41.   MainGadgets*: ARRAY MainCNT OF I.GadgetPtr;
  42.   MainMenus-: I.MenuPtr;
  43.   MainZoom-: ARRAY 4 OF INTEGER;
  44.   Font-: g.TextAttrPtr;
  45.   Attr-: g.TextAttr;
  46.   FontX, FontY: INTEGER;
  47.   OffX, OffY: INTEGER;
  48.  
  49. TYPE
  50.   Gadget500LArray = ARRAY     6 OF e.STRPTR;
  51. CONST
  52.   Gadget500Labels = Gadget500LArray (
  53.     y.ADR ("This"),
  54.     y.ADR ("Is"),
  55.     y.ADR ("A"),
  56.     y.ADR ("Cycle"),
  57.     y.ADR ("Gadget"),
  58.     NIL);
  59.  
  60. VAR
  61. TYPE
  62.   MainMArray = ARRAY    27 OF gt.NewMenu;
  63. CONST
  64.   MainNewMenu = MainMArray (
  65.     gt.title, y.ADR ("Project"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  66.     gt.item, y.ADR ("New"), y.ADR ("N"), {}, y.VAL (LONGSET, 0), NIL,
  67.     gt.item, y.ADR ("Open..."), y.ADR ("O"), {}, y.VAL (LONGSET, 0), NIL,
  68.     gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
  69.     gt.item, y.ADR ("Save"), y.ADR ("S"), {}, y.VAL (LONGSET, 0), NIL,
  70.     gt.item, y.ADR ("Save As..."), y.ADR ("A"), {}, y.VAL (LONGSET, 0), NIL,
  71.     gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
  72.     gt.item, y.ADR ("Quit"), y.ADR ("Q"), {}, y.VAL (LONGSET, 0), NIL,
  73.     gt.title, y.ADR ("Edit"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  74.     gt.item, y.ADR ("Cut"), y.ADR ("X"), {}, y.VAL (LONGSET, 0), NIL,
  75.     gt.item, y.ADR ("Copy"), y.ADR ("C"), {}, y.VAL (LONGSET, 0), NIL,
  76.     gt.item, y.ADR ("Paste"), y.ADR ("V"), {}, y.VAL (LONGSET, 0), NIL,
  77.     gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
  78.     gt.item, y.ADR ("Erase"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  79.     gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
  80.     gt.item, y.ADR ("Undo"), y.ADR ("Z"), {}, y.VAL (LONGSET, 0), NIL,
  81.     gt.title, y.ADR ("Macro"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  82.     gt.item, y.ADR ("Start Learning"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  83.     gt.item, y.ADR ("Stop Learning"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  84.     gt.item, y.ADR ("Assign Macro..."), NIL, {}, y.VAL (LONGSET, 0), NIL,
  85.     gt.title, y.ADR ("Settings"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  86.     gt.item, y.ADR ("Create Icons?"), y.ADR ("I"), {I.checkIt,I.checked,I.menuToggle}, y.VAL (LONGSET, 0), NIL,
  87.     gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
  88.     gt.item, y.ADR ("Meal"), NIL, {}, y.VAL (LONGSET, 0), NIL,
  89.     gt.sub, y.ADR ("Raw"), NIL, {I.checkIt}, y.VAL (LONGSET, 2), NIL,
  90.     gt.sub, y.ADR ("Cooked"), NIL, {I.checkIt,I.checked}, y.VAL (LONGSET, 1), NIL,
  91.     gt.end, NIL, NIL, {}, LONGSET {}, NIL);
  92. TYPE
  93.   MainGTypesArray = ARRAY MainCNT OF INTEGER;
  94. CONST
  95.   MainGTypes = MainGTypesArray (
  96.     gt.buttonKind,
  97.     gt.buttonKind,
  98.     gt.buttonKind,
  99.     gt.integerKind,
  100.     gt.numberKind,
  101.     gt.cycleKind,
  102.     gt.paletteKind,
  103.     gt.scrollerKind,
  104.     gt.sliderKind,
  105.     gt.stringKind,
  106.     gt.textKind,
  107.     gt.buttonKind
  108.   );
  109.  
  110. TYPE
  111.   MainNGadArray = ARRAY MainCNT OF gt.NewGadget;
  112. CONST
  113.   MainNGad = MainNGadArray (
  114.     4, 86, 129, 14, y.ADR ("Save First"), NIL, GDGadget00, LONGSET {gt.placeTextIn} ,NIL, NIL,
  115.     165, 86, 129, 14, y.ADR ("Continue"), NIL, GDGadget10, LONGSET {gt.placeTextIn} ,NIL, NIL,
  116.     328, 86, 129, 14, y.ADR ("Cancel"), NIL, GDGadget20, LONGSET {gt.placeTextIn} ,NIL, NIL,
  117.     130, 4, 164, 14, y.ADR ("Integer Gadget"), NIL, GDGadget30, LONGSET {gt.placeTextLeft} ,NIL, NIL,
  118.     131, 20, 163, 14, y.ADR ("Number Gadget "), NIL, GDGadget40, LONGSET {gt.placeTextLeft} ,NIL, NIL,
  119.     11, 36, 283, 14, NIL, NIL, GDGadget50, LONGSET {} ,NIL, NIL,
  120.     12, 52, 282, 28, NIL, NIL, GDGadget60, LONGSET {} ,NIL, NIL,
  121.     297, 4, 21, 76, NIL, NIL, GDGadget70, LONGSET {} ,NIL, NIL,
  122.     322, 4, 21, 76, NIL, NIL, GDGadget80, LONGSET {} ,NIL, NIL,
  123.     346, 4, 105, 14, NIL, NIL, GDGadget90, LONGSET {} ,NIL, NIL,
  124.     347, 20, 104, 14, NIL, NIL, GDGadget100, LONGSET {} ,NIL, NIL,
  125.     347, 36, 104, 44, y.ADR ("Big Button"), NIL, GDGadget110, LONGSET {gt.placeTextIn} ,NIL, NIL
  126.   );
  127.  
  128. TYPE
  129.   MainGTagsArray = ARRAY    48 OF u.Tag;
  130. CONST
  131.   MainGTags = MainGTagsArray (
  132.     u.done,
  133.     u.done,
  134.     u.done,
  135.     gt.inNumber, 0, gt.inMaxChars, 666, u.done,
  136.     gt.nmBorder, I.LTRUE, u.done,
  137.     gt.cyLabels, y.ADR (Gadget500Labels[0]), u.done,
  138.     gt.paDepth, 2, gt.paIndicatorWidth, 40, u.done,
  139.     gt.scTotal, 20, gt.scArrows, 16, I.pgaFreedom, I.lorientVert, I.gaRelVerify, I.LTRUE, u.done,
  140.     gt.slMaxLevelLen, 2, gt.slLevelFormat, y.ADR (""), I.pgaFreedom, I.lorientVert, I.gaRelVerify, I.LTRUE, u.done,
  141.     gt.stString, y.ADR ("String"), gt.stMaxChars, 256, u.done,
  142.     gt.txText, y.ADR ("Text"), gt.txBorder, I.LTRUE, u.done,
  143.     u.done
  144.   );
  145.  
  146. PROCEDURE ComputeX (value: INTEGER): INTEGER;
  147. BEGIN
  148.   RETURN ((FontX * value) + 4 ) DIV 8;
  149. END ComputeX;
  150.  
  151. PROCEDURE ComputeY (value: INTEGER): INTEGER;
  152. BEGIN
  153.   RETURN ((FontY * value)  + 4 ) DIV 8;
  154. END ComputeY;
  155.  
  156. PROCEDURE ComputeFont (width, height: INTEGER);
  157. BEGIN
  158.   Font := y. ADR (Attr);
  159.   Font^.name := Scr^.rastPort.font^.message.node.name;
  160.   FontY := Scr^.rastPort.font^.ySize;
  161.   Font^.ySize := FontY;
  162.   FontX := Scr^.rastPort.font^.xSize;
  163.  
  164.   OffX := Scr^.wBorLeft;
  165.   OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
  166.  
  167.   IF (width # 0) AND (height # 0) AND
  168.      (ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
  169.      (ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
  170.     Font^.name := y.ADR ("topaz.font");
  171.     Font^.ySize := 8;
  172.     FontY := Font^.ySize;
  173.     FontX := Font^.ySize;
  174.   END;
  175. END ComputeFont;
  176.  
  177. PROCEDURE SetupScreen* (): INTEGER; (* $CopyArrays- *)
  178. BEGIN
  179.   Scr := I.LockPubScreen ("Workbench");  IF Scr = NIL THEN RETURN 1 END;
  180.  
  181.   ComputeFont (0, 0);
  182.  
  183.   VisualInfo := gt.GetVisualInfo (Scr, u.done);
  184.   IF VisualInfo = NIL THEN RETURN 2 END;
  185.  
  186.   RETURN 0;
  187. END SetupScreen;
  188.  
  189. PROCEDURE CloseDownScreen*;
  190. BEGIN
  191.   IF VisualInfo # NIL THEN
  192.     gt.FreeVisualInfo (VisualInfo);
  193.     VisualInfo := NIL;
  194.   END;
  195.   IF Scr # NIL THEN
  196.     I.UnlockPubScreen (NIL, Scr);
  197.     Scr := NIL;
  198.   END;
  199. END CloseDownScreen;
  200.  
  201. PROCEDURE MainRender*;
  202. BEGIN
  203.   gt.DrawBevelBox (MainWnd^.rPort,
  204.                   OffX + ComputeX (5), OffY + ComputeY (1),
  205.                   ComputeX (453), ComputeY (82),
  206.                   gt.visualInfo, VisualInfo, u.done);
  207. END MainRender;
  208.  
  209. PROCEDURE CreateMainGadgets* (): INTEGER;
  210. TYPE
  211.   TagArrayPtr = UNTRACED POINTER TO ARRAY MAX (INTEGER) OF u.TagItem;
  212. VAR
  213.   ng: gt.NewGadget;
  214.   gad: I.GadgetPtr;
  215.   help: TagArrayPtr;
  216.   ret, lc, tc, lvc, offx, offy: INTEGER;
  217. BEGIN
  218.   ComputeFont (MainWidth, MainHeight);
  219.  
  220.   gad := gt.CreateContext (MainGList);
  221.   IF gad = NIL THEN RETURN 1 END;
  222.  
  223.   lc := 0; tc := 0; lvc := 0;
  224.   WHILE lc < MainCNT DO
  225.     ng := MainNGad[lc];
  226.     ng.visualInfo := VisualInfo;
  227.     ng.textAttr   := Font;
  228.     ng.leftEdge   := OffX + ComputeX (ng.leftEdge);
  229.     ng.topEdge    := OffY + ComputeY (ng.topEdge);
  230.     ng.width      := ComputeX (ng.width);
  231.     ng.height     := ComputeY (ng.height);
  232.  
  233.     help := u.CloneTagItems (y.VAL (TagArrayPtr, y.ADR (MainGTags[tc]))^);
  234.     IF help = NIL THEN RETURN 8 END;
  235.     gad := gt.CreateGadgetA (MainGTypes[lc], gad, ng, help^);
  236.     u.FreeTagItems (help^);
  237.     IF gad = NIL THEN RETURN 2 END;
  238.     MainGadgets[lc] := gad;
  239.  
  240.     WHILE MainGTags[tc] # u.done DO INC (tc, 2) END;
  241.     INC (tc);
  242.  
  243.     INC (lc);
  244.   END; (* WHILE *)
  245.  
  246.   RETURN 0;
  247. END CreateMainGadgets;
  248.  
  249. PROCEDURE OpenMainWindow* (createGads: BOOLEAN): INTEGER;
  250. VAR
  251.   offx, offy, ret: INTEGER;
  252.   wleft, wtop, ww, wh: INTEGER;
  253. BEGIN
  254.   wleft := MainLeft; wtop := MainTop;
  255.  
  256.   ComputeFont (MainWidth, MainHeight);
  257.  
  258.   ww := ComputeX (MainWidth);
  259.   wh := ComputeY (MainHeight);
  260.  
  261.   IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
  262.     wleft := Scr^.width - ww;
  263.   END;
  264.   IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
  265.     wtop := Scr^.height - wh;
  266.   END;
  267.  
  268.   IF createGads THEN
  269.      ret := CreateMainGadgets(); IF ret # 0 THEN RETURN ret END;
  270.   END;
  271.  
  272.   MainMenus := gt.CreateMenus (MainNewMenu, gt.mnFrontPen, 0, u.done);
  273.   IF MainMenus = NIL THEN RETURN 3 END;
  274.  
  275.   IF NOT gt.LayoutMenus (MainMenus, VisualInfo, u.done) THEN RETURN 4 END;
  276.  
  277.   MainZoom[0] := MainLeft;
  278.   MainZoom[1] := MainTop;
  279.   MainZoom[2] := g.TextLength (y.ADR (Scr^.rastPort), "Font Adapt Test...", 18) + 80;
  280.   MainZoom[3] := Scr^.wBorTop + Scr^.rastPort.txHeight + 1;
  281.  
  282.   MainWnd := I.OpenWindowTagsA ( NIL,
  283.                     I.waLeft,          wleft,
  284.                     I.waTop,           wtop,
  285.                     I.waWidth,         ww + OffX + Scr^.wBorRight,
  286.                     I.waHeight,        wh + OffY + Scr^.wBorBottom,
  287.                     I.waIDCMP,         gt.buttonIDCMP+gt.integerIDCMP+gt.numberIDCMP+gt.cycleIDCMP+gt.paletteIDCMP+gt.scrollerIDCMP+gt.arrowIDCMP+gt.sliderIDCMP+gt.stringIDCMP+gt.textIDCMP+LONGSET {I.menuPick,I.closeWindow,I.refreshWindow},
  288.                     I.waFlags,         LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.sizeBRight,I.sizeBBottom,I.activate},
  289.                     I.waTitle,         y.ADR ("Font Adapt Test..."),
  290.                     I.waScreenTitle,   y.ADR ("GadToolsBox Demo"),
  291.                     I.waZoom,          y.ADR (MainZoom),
  292.                     I.waGadgets,       MainGList,
  293.                     u.done);
  294.   IF MainWnd = NIL THEN RETURN 20 END;
  295.  
  296.   IF NOT I.SetMenuStrip (MainWnd, MainMenus^) THEN RETURN 5 END;
  297.   MainRender;
  298.  
  299.   RETURN 0;
  300. END OpenMainWindow;
  301.  
  302. PROCEDURE CloseMainWindow*;
  303. BEGIN
  304.   IF MainMenus # NIL THEN
  305.     IF MainWnd # NIL THEN
  306.       I.ClearMenuStrip (MainWnd);
  307.     END;
  308.     gt.FreeMenus (MainMenus);
  309.     MainMenus := NIL;
  310.   END;
  311.   IF MainWnd # NIL THEN
  312.     I.CloseWindow (MainWnd);
  313.     MainWnd := NIL;
  314.   END;
  315.   IF MainGList # NIL THEN
  316.     gt.FreeGadgets (MainGList);
  317.     MainGList := NIL;
  318.   END;
  319. END CloseMainWindow;
  320.  
  321.  
  322. END FontAdapt.
  323.